home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 007 / bwtool01.arc / POPMENU.SUB < prev    next >
Encoding:
Text File  |  1986-11-29  |  3.4 KB  |  130 lines
  1.       '***********************************************************************
  2.        SUB POPMENU(HEADER$,CHOICES%,ITEM$(1),FRAME%,FORE%,BACK%,HFORE%,HBACK%,QUADRANT$,SHADOW%,SELECT%) STATIC
  3.        DEFINT A-Z
  4.        
  5.        'Determine width of window from length of items
  6.  
  7.        WINDLEN=LEN(HEADER$)
  8.        FOR J=1 TO CHOICES
  9.            IF LEN(ITEM$(J)) > WINDLEN THEN WINDLEN=LEN(ITEM$(J))
  10.        NEXT J
  11.  
  12.        'If Quadrant is in ROW:COL format, extract Row and Column
  13.  
  14.         IF INSTR(QUADRANT$,":")<>0 THEN GOSUB GETORD:GOTO GO1
  15.  
  16.        'Determine Position based on Quadrant Parameter and size of menu
  17.  
  18.        QUADRANT=VAL(QUADRANT$)
  19.        IF QUADRANT >4 OR QUADRANT <0 THEN QUADRANT=0
  20.        IF QUADRANT=0 THEN CROW=12:CCOL=40 ELSE ON QUADRANT GOSUB QUAD1,QUAD2,QUAD3,QUAD4
  21.        ULR=CROW-((CHOICES+2)/2-.5)
  22.        ULC=CCOL-((WINDLEN/2)-.5)
  23.        LRR=ULR+CHOICES+1
  24.        LRC=ULC+WINDLEN-1
  25.  
  26. GO1:    'Create Window for Menu
  27.  
  28.  
  29.        CALL MAKEWIND(ULR,ULC,LRR,LRC,FRAME,FORE,BACK,GROW,SHADOW,LABEL$)
  30.  
  31.        'Place Header in Window
  32.  
  33.        TEMPHDR$=SPACE$(WINDLEN)
  34.        IF LEN(HEADER$)<> WINDLEN THEN GOSUB PUTHDR
  35.  
  36.        ATTR=(HBACK AND 7)*16+HFORE
  37.        ROW=ULR:COL=ULC
  38.        CALL FASTPRT(HEADER$,ROW,COL,ATTR)
  39.        ATTR=(BACK AND 7)*16+FORE
  40.        ROW=ULR+1:COL=ULC
  41.        DAT$=STRING$(WINDLEN,205)
  42.        CALL FASTPRT(DAT$,ROW,COL,ATTR)
  43.  
  44.        'Place Menu Items in Window
  45.  
  46.        FOR J=1 TO CHOICES
  47.          ATTR=(BACK AND 7)*16+FORE
  48.          ROW=(ULR+1+J):COL=ULC
  49.          DAT$=ITEM$(J)
  50.          CALL FASTPRT(DAT$,ROW,COL,ATTR)
  51.        NEXT J
  52.  
  53.        'Set current choice to Menu Item #1 and enter Loop
  54.  
  55.        SELECT=1
  56.        GOSUB TON
  57.  
  58. LOOP:  GOSUB PROCESS:'Update Position of Selection Marker
  59.        GOSUB PRESS:'Get KeyPress
  60.        IF KP$=CHR$(13) OR KP$=CHR$(27) THEN GOTO DONE
  61.        GOTO LOOP
  62.  
  63.  
  64.        'Check for KeyPress and sound error if not UP ARROW, DOWN ARROW, or RETURN
  65.  
  66. PRESS: KP$=INKEY$
  67.        IF KP$="" THEN GOTO PRESS
  68.        IF KP$=CHR$(13) THEN RETURN
  69.        IF KP$=CHR$(27) THEN SELECT=0:RETURN
  70.        IF LEN(KP$)=1 THEN SOUND 1000,1:SOUND 1500,2:SOUND 500,1:GOTO PRESS
  71.  
  72.        'Process DOWN ARROW KeyPress
  73.  
  74.        IF ASC(RIGHT$(KP$,1))=80 THEN OLD=SELECT:SELECT=SELECT+1:IF SELECT > CHOICES THEN SELECT=1:RETURN ELSE RETURN
  75.  
  76.        'Process UP ARROW KeyPress
  77.  
  78.        IF ASC(RIGHT$(KP$,1))=72 THEN OLD=SELECT:SELECT=SELECT-1:IF SELECT < 1 THEN SELECT=CHOICES:RETURN ELSE RETURN
  79.  
  80.        'Process ERROR
  81.  
  82.        SOUND 1000,1:SOUND 1500,2:SOUND 500,1:GOTO PRESS
  83.  
  84. PROCESS:
  85.  
  86.        'Turn off present selection
  87.        ATTR=(BACK * 16)+FORE
  88.        ROW=(ULR+1+OLD):COL=ULC
  89.        DAT$=ITEM$(OLD)
  90.        CALL FASTPRT(DAT$,ROW,COL,ATTR)
  91.  
  92.        'Turn on new selection
  93.  
  94. TON:   ATTR=(FORE * 16)+BACK
  95.        ROW=(ULR+1+SELECT):COL=ULC
  96.        DAT$=ITEM$(SELECT)
  97.        CALL FASTPRT(DAT$,ROW,COL,ATTR)
  98.  
  99.        RETURN
  100.  
  101. QUAD1: CROW=7
  102.        CCOL=20
  103.        RETURN
  104. QUAD2: CROW=7
  105.        CCOL=60
  106.        RETURN
  107. QUAD3: CROW=18
  108.        CCOL=60
  109.        RETURN
  110. QUAD4: CROW=18
  111.        CCOL=20
  112.        RETURN
  113.  
  114. GETORD:
  115.  
  116.        ULR=VAL(LEFT$(QUADRANT$,2))+1
  117.        ULC=VAL(RIGHT$(QUADRANT$,2))
  118.        LRR=ULR+CHOICES+1
  119.        LRC=ULC+WINDLEN-1
  120.        RETURN
  121.  
  122. PUTHDR:
  123.  
  124.        PAD=(WINDLEN/2)-(LEN(HEADER$)/2)-.5
  125.        MID$(TEMPHDR$,PAD+1,LEN(HEADER$))=HEADER$
  126.        HEADER$=TEMPHDR$
  127.        RETURN
  128.  
  129. DONE:  END SUB
  130.